home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 191 / applic / vdiproc.pas < prev    next >
Pascal/Delphi Source File  |  1987-11-20  |  5KB  |  219 lines
  1. procedure AES_CALL(     OP : integer;
  2.                     var int_in : int_in_parms;
  3.                     var int_out : int_out_parms;
  4.                     var addr_in : addr_in_parms;
  5.                     var addr_out : addr_out_parms
  6.                   );
  7. external;
  8.  
  9. procedure VDI_CALL( CMD, SUB_CMD, NINTS, NPTS : integer;
  10.                     var ctrl : ctrl_parms;
  11.                     var int_in : int_in_parms; var int_out : int_out_parms;
  12.                     var pts_in : pts_in_parms; var pts_out : pts_out_parms;
  13.                     translate : boolean
  14.                   );
  15. external;
  16.  
  17. procedure vsf_interior( FILL_STYLE : integer );
  18.   begin
  19.     INT_IN[ 0 ] := FILL_STYLE;
  20.     VDI_CALL( 23, 0, 1, 0,
  21.               CONTROL,
  22.               INT_IN, INT_OUT,
  23.               PTS_IN, PTS_OUT,
  24.               false
  25.             );
  26.   end;
  27.  
  28. procedure vsf_updat( FILL_PAT : FILL_PAT_TYPE );
  29.   var
  30.     I : integer;
  31.   begin
  32.     for I := 1 to 16 do
  33.       INT_IN[ I-1 ] := FILL_PAT[ I ];
  34.     VDI_CALL( 112, 0, 16, 0,
  35.               CONTROL,
  36.               INT_IN, INT_OUT,
  37.               PTS_IN, PTS_OUT,
  38.               false
  39.             );
  40.   end;
  41.  
  42.  
  43. procedure vsf_color( COLOR_INDEX : integer );
  44.   begin
  45.     INT_IN[ 0 ] := COLOR_INDEX;
  46.     VDI_CALL( 25, 0, 1, 0,
  47.               CONTROL,
  48.               INT_IN, INT_OUT,
  49.               PTS_IN, PTS_OUT,
  50.               false
  51.             );
  52.   end;
  53.  
  54. procedure vsf_style( STYLE_INDEX : integer );
  55.   begin
  56.     INT_IN[ 0 ] := STYLE_INDEX;
  57.     VDI_CALL( 24, 0, 1, 0,
  58.               CONTROL,
  59.               INT_IN, INT_OUT,
  60.               PTS_IN, PTS_OUT,
  61.               false
  62.             );
  63.   end;
  64.  
  65. procedure vst_alignment( HOR_IN, VERT_IN : integer;
  66.                          var HOR_OUT, VERT_OUT : integer
  67.                        );
  68.   begin
  69.     INT_IN[ 0 ] := HOR_IN;
  70.     INT_IN[ 1 ] := VERT_IN;
  71.     VDI_CALL( 39, 0, 2, 0,
  72.               CONTROL,
  73.               INT_IN, INT_OUT,
  74.               PTS_IN, PTS_OUT,
  75.               false
  76.             );
  77.     HOR_OUT  := INT_OUT[ 0 ];
  78.     VERT_OUT := INT_OUT[ 1 ];
  79.   end;
  80.  
  81. procedure vsl_ends( BEG_STYLE, END_STYLE : integer );
  82.   begin
  83.     INT_IN[ 0 ] := BEG_STYLE;
  84.     INT_IN[ 1 ] := END_STYLE;
  85.     VDI_CALL( 108, 0, 2, 0,
  86.               CONTROL,
  87.               INT_IN, INT_OUT,
  88.               PTS_IN, PTS_OUT,
  89.               false
  90.             );
  91.   end;
  92.  
  93. procedure vsl_color( COLOR_INDEX : integer );
  94.   begin
  95.     INT_IN[ 0 ] := COLOR_INDEX;
  96.     VDI_CALL( 17, 0, 1, 0,
  97.               CONTROL,
  98.               INT_IN, INT_OUT,
  99.               PTS_IN, PTS_OUT,
  100.               false
  101.             );
  102.   end;
  103.  
  104. procedure vsl_width( LINE_WIDTH : integer );
  105.   begin
  106.     PTS_IN[ 0 ] := LINE_WIDTH;
  107.     PTS_IN[ 1 ] := 0;
  108.     VDI_CALL( 16, 0, 0, 1,
  109.               CONTROL,
  110.               INT_IN, INT_OUT,
  111.               PTS_IN, PTS_OUT,
  112.               false
  113.             );
  114.   end;
  115.  
  116. procedure mfdbptr_to_ar2( MP : mfdbptr;
  117.                           var MA : AR2
  118.                         );
  119.   var
  120.     COERCE : record
  121.                case boolean of
  122.                  false : ( MPTR : mfdbptr );
  123.                  true  : ( MARR : AR2 );
  124.              end;
  125.   begin
  126.     COERCE.MPTR := MP;
  127.     MA[ 0 ] := COERCE.MARR[ 0 ];
  128.     MA[ 1 ] := COERCE.MARR[ 1 ];
  129.   end;
  130.  
  131.  
  132. procedure vro_cpyform( WR_MODE : integer;
  133.                        PXY : PXYARRAY;
  134.                        SOURCE, DESTIN : mfdbptr
  135.                      );
  136.   var
  137.     I : integer;
  138.     AARRAY : AR2;
  139.   begin
  140.     INT_IN[ 0 ] := WR_MODE;
  141.     for I := 0 to 7 do PTS_IN[ I ] := PXY[ I ];
  142.     mfdbptr_to_ar2( SOURCE, AARRAY );
  143.     CONTROL[ 7 ] := AARRAY[ 0 ];        CONTROL[ 8 ] := AARRAY[ 1 ];
  144.     mfdbptr_to_ar2( DESTIN, AARRAY );
  145.     CONTROL[ 9 ] := AARRAY[ 0 ];        CONTROL[ 10 ] := AARRAY[ 1 ];
  146.     VDI_CALL( 109, 0, 1, 4,
  147.               CONTROL,
  148.               INT_IN, INT_OUT,
  149.               PTS_IN, PTS_OUT,
  150.               false
  151.             );
  152.   end;
  153.  
  154.  
  155. procedure v_pline( COUNT : integer;
  156.                    PXY   : PXYARRAY
  157.                  );
  158.   var
  159.     I : integer;
  160.   begin
  161.     for I := 0 to (2*COUNT)-1 do PTS_IN[ I ] := PXY[ I ];
  162.     VDI_CALL( 6, 0, 0, COUNT,
  163.               CONTROL,
  164.               INT_IN, INT_OUT,
  165.               PTS_IN, PTS_OUT,
  166.               false
  167.             );
  168.  
  169.   end;
  170.  
  171.  
  172. procedure v_gtext( X, Y : integer;
  173.                    TEXT : string
  174.                  );
  175.   var
  176.     I : integer;
  177.  
  178.   begin
  179.     PTS_IN[ 0 ] := X;
  180.     PTS_IN[ 1 ] := Y;
  181.     for I := 1 to length(TEXT) do INT_IN[ I - 1 ] := ord( TEXT[ I ] );
  182.     VDI_CALL( 8, 0, length(TEXT), 2,
  183.               CONTROL,
  184.               INT_IN, INT_OUT,
  185.               PTS_IN, PTS_OUT,
  186.               false
  187.             );
  188.   end;
  189.  
  190. procedure v_bar( XUL, YUL, XLR, YLR : integer );
  191.   begin
  192.     PTS_IN[ 0 ] := XUL;
  193.     PTS_IN[ 1 ] := YUL;
  194.     PTS_IN[ 2 ] := XLR;
  195.     PTS_IN[ 3 ] := YLR;
  196.     VDI_CALL( 11, 1, 0, 4,
  197.               CONTROL,
  198.               INT_IN, INT_OUT,
  199.               PTS_IN, PTS_OUT,
  200.               false
  201.             );
  202.   end;
  203.  
  204.  
  205. procedure v_ellipse( X, Y, XRADIUS, YRADIUS : integer );
  206.   begin
  207.     PTS_IN[ 0 ] := X;
  208.     PTS_IN[ 1 ] := Y;
  209.     PTS_IN[ 2 ] := XRADIUS;
  210.     PTS_IN[ 3 ] := YRADIUS;
  211.  
  212.     VDI_CALL( 11, 5, 0, 4,
  213.               CONTROL,
  214.               INT_IN, INT_OUT,
  215.               PTS_IN, PTS_OUT,
  216.               false
  217.             );
  218.   end;
  219.